home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / tphers01.zip / HMP2INC.PL < prev    next >
Text File  |  1991-09-08  |  2KB  |  86 lines
  1. ##########################################################################
  2. #
  3. #  Perl program to read a hmp file and expand it to a constant record
  4. #
  5. #  Run the script by typing 
  6. #
  7. #    perl fontfile
  8. #
  9. #  where fontfile.hmp is a font file with the mapping of the 
  10. #  characters 32-127 to Hershey symbols.
  11. #
  12. ##########################################################################
  13. while ($ARGV[0]=~ /\.hmp/i) {
  14.   $fontName= $ARGV[0];
  15.   $fontName=~ s/\.hmp//i;  # Erase the file extension
  16.   $fontName=~ tr/A-Z/a-z/;
  17.   $fontName=~ s/^(.)$/ $ch=$1, $ch=~tr|a-z|A-Z|, $ch/e;  
  18.   &printHeader;
  19.   open(IN, $ARGV[0]);
  20.   while(<IN>) {
  21.     @charNumbers=split(/\s+/);
  22.     foreach (@charNumbers) {
  23.       if (/(\d+)\-(\d+)/) {
  24.         for $i ($1..$2) {
  25.           if (32 + $numCount > 127) { 
  26.             print STDERR "Warning! Too many entries in HMP file! Truncating...\n"; 
  27.             goto GotEnough; 
  28.           }
  29.           &printNum($i);
  30.           $numCount++;
  31.         }
  32.       }
  33.       else {
  34.         if (32 + $numCount > 127) { 
  35.           print STDERR "Warning! Too many entries in HMP file! Truncating...\n";
  36.           goto GotEnough; 
  37.         }
  38.         &printNum($_);
  39.         $numCount++;
  40.       }
  41.     }
  42.   }
  43.  
  44. GotEnough:
  45.   close(IN);
  46.   
  47.   # Fill the rest of the table with the zero character 
  48.   if (32 + $numCount <= 127) {
  49.     print STDERR "Not enough entries in HMP file. Filling reminder with zeroes.\n";
  50.   }
  51.   for (32+$numCount..127) { &printNum(0); }
  52.   &printTail;
  53.   print "\n";
  54.  
  55.   # Now there is just one comma too many at the very, very end. Erase it...
  56.   $*=1;         # Set multiline handling on
  57.   $outString=~ s/,\)/\)/;
  58.   $outString=~ s/,(\n\s*\))/\)/;
  59.   
  60.   # print the new neatlooking character table
  61.   print $outString;
  62.  
  63.   shift;
  64. }
  65.  
  66. #######################################################################
  67. # Output routines. They can easily be changed for any programming 
  68. # language. This version is for a constant record in Turbo Pascal.
  69. #######################################################################
  70. sub printHeader {
  71.   $outString= "const\n  Hershey" . $fontName ." : HersheyFont = (\n  ";
  72. }
  73.  
  74. sub printTail {
  75.   $outString .= ");\n";
  76. }
  77.  
  78. sub printNum {
  79.   $outString .= sprintf("%4d,", $_[0]);
  80.   if (++$numNumbersOnLine == 16) {
  81.     $numNumbersOnLine = 0;
  82.     $outString .= "\n  ";
  83.   }
  84. }
  85.  
  86.